home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d17 / labelrx4.arc / LABELRX4.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-06-10  |  8.1 KB  |  249 lines
  1. 10  REM  ************************************************************
  2. 15  REM  ***                   LABELRX4    VERS 1.0               ***
  3. 20  REM  ***  DISKETTE LABEL PRINTER - R. W. LENNOX (313)689-6139 ***
  4. 25  REM  ***  MODIFIED BY RON ROWE - SORBUS INC. RBBS 405-495-3397***
  5. 30  REM  ***  COMMENT LINES OPTIONAL FOR 4" LABELS -jw 12/29/84   ***
  6. 40  REM  ***  USES 1 1/2 x 4 INCH  1-UP LABEL STOCK               ***
  7. 50  REM  ***  WRITTEN FOR EPSON RX-80                             ***
  8. 60  REM  ***  REQUIRES 80 COLUMN MONITOR - USES NO GRAPHICS       ***
  9. 70  REM  ***  WRITTEN FOR DOS 2.0 - 3.0                           ***
  10. 90  REM  ***  REQUIRED FILE - DIRECTRY.COM FROM "SOFTTALK" 01/84  ***
  11. 100  REM ***  IS ENCLUDED IN THIS PACKAGE. BUY THE MAGAZINE!      ***
  12. 101  REM ***  ORIGIONAL PROGRAM NAMED LABELSMC.BAS                ***
  13. 110  REM ************************************************************
  14. 120  SCREEN 0:KEY OFF:DEF SEG
  15. 125  DEFINT I-N
  16. 130  SUBRT$=STRING$(159,32)
  17. 140  SUBLC%=VARPTR(SUBRT$)
  18. 150  GOSUB 2270
  19. 160  BLOAD "DIRECTRY.COM",DIRECT
  20. 170  FCB$=STRING$(33,32)
  21. 180  DTA$=STRING$(33,32)
  22. 190  DIM PROG$(64)
  23. 200  DIM PROGEXT$(64)
  24. 210  DIM CPROG$(64)
  25. 220  DIM PROGSEL(64)
  26. 230  DIM DIRLST$(512)
  27. 240  FILLER$=STRING$(12,32)
  28. 250  COMA$="":                  REM COMMENT LINE ONE
  29. 260  COMB$="":                  REM COMMENT LINE TWO
  30. 270  COMC$="":                  REM COMMENT LINE THREE
  31. 280  NDATE$=LEFT$(DATE$,6)+RIGHT$(DATE$,2)
  32. 290  FOR LOOP%=0 TO 512:DIRLST$(LOOP%)=FILLER$:NEXT
  33. 340  N=0:COUNT%=0
  34. 350  FOR X=1 TO 64:PROGSEL(X)=0:NEXT X
  35. 360  CLS
  36. 370  COLOR 0,7:
  37. 380  LOCATE 1,15:PRINT "                                          "
  38. 390  LOCATE 2,15:PRINT "         DISKETTE LABEL PRINT             "
  39. 400  LOCATE 3,15:PRINT "             EPSON RX-80                 "
  40. 410  COLOR 7,0:
  41. 420  LOCATE 5,15:PRINT "THIS PROGRAM ALLOWS PRODUCTION OF DISKETTE"
  42. 430  LOCATE 6,15:PRINT "LABELS  USING  DIRECTORY  DATA AND A  USER"
  43. 440  LOCATE 7,15:PRINT "SUPPLIED TITLE.   INCLUSION  OF  DIRECTORY"
  44. 450  LOCATE 8,15:PRINT "ENTRIES (ALL/NONE/SELECTED) IS  CONTROLLED"
  45. 460  LOCATE 9,15:PRINT "BY THE OPERATOR.                          "
  46. 470  LOCATE 12,18:PRINT "ENTER 'X' FOR SYSTEM - ESCape TO END"
  47. 480  COLOR 0,7:
  48. 490  LOCATE 15,19:PRINT "                                  "
  49. 500  LOCATE 15,19:PRINT "ENTER TARGET DISK (ie. A,B,C,D): ";
  50. 510  GOSUB 2210:DSK$=KY$
  51. 520  HIT%=INSTR("ABCDX",DSK$)
  52. 530  IF HIT%=0 THEN GOTO 560 ELSE PRINT DSK$
  53. 540  IF DSK$="X" THEN 2180
  54. 550  COLOR 7,0:GOTO 580
  55. 560  LOCATE 18,22:PRINT "INCORRECT TARGET DISK ENTERED"
  56. 570  BEEP:GOTO 480
  57. 580  LOCATE 18,22:PRINT "ENTER 'Y' TO READ DIRECTORY:     ";
  58. 590  GOSUB 2210:DTY$=KY$:PRINT DTY$
  59. 600  CLS
  60. 610  WIDTH 80
  61. 620  IF DTY$="Y" THEN 630 ELSE 750
  62. 630  LOCATE ,,0:GOSUB 2270
  63. 640  REM GET DIRECTORY AND SORT
  64. 650  CALL DIRECT(DSK$,FCB$,DTA$,DIRLST$(0),COUNT%)
  65. 660  F=1:I=0:LOCATE 10,20:PRINT "SORTING......PLEASE WAIT"
  66. 665  GOSUB 6000:GOTO 700
  67. 670  IF DIRLST$(I)>DIRLST$(I+1) THEN SWAP DIRLST$(I),DIRLST$(I+1):F=0
  68. 680  I=I+1:IF I<COUNT%-1 THEN 670
  69. 690  IF F= 1 THEN 700
  70. 691  IF DIRLST$(I-1)>DIRLST$(I) THEN SWAP DIRLST$(I),DIRLST$(I-1):F=0
  71. 692  I=I-1:IF I > 0 THEN 691
  72. 693  IF F= 0 THEN F = 1:GOTO 670
  73. 700  CLS
  74. 710  LOCATE 2,10:PRINT "DIRECTORY ON DRIVE "DSK$": CONTAINS "COUNT%" ENTRIES"
  75. 720  IF COUNT%>55 THEN COUNT%=50:PRINT "ONLY 50 ENTRIES ALLOWED"
  76. 730  PRINT
  77. 740  FOR LOOP=0 TO COUNT%-1:PRINT DIRLST$(LOOP)SPC(6);:NEXT:PRINT
  78. 750  COLOR 0,7:
  79. 760  LOCATE 17,5:PRINT "                                                            "
  80. 770  LOCATE 17,5:INPUT "ENTER DISKETTE LABEL TITLE ",TITLE$
  81. 780  COLOR 7,0:
  82. 790  IF LEN(TITLE$) < 34 THEN 820
  83. 800  BEEP:LOCATE 21,10:PRINT "MAXUMUM OF 33 CHARACTERS ALLOWED"
  84. 810  GOTO 750
  85. 820  LOCATE 21,10:PRINT "                        "
  86. 830  COLOR 0,7:
  87. 840  LOCATE 18,5:PRINT "                               "
  88. 850  LOCATE 18,43:PRINT"001"
  89. 860  LOCATE 18,5:INPUT "ENTER DISKETTE VERSION NUMBER (000)   ",DSER$
  90. 870  IF DSER$="" THEN DSER$="001"
  91. 880  LOCATE 19,5:PRINT "                                            "
  92. 890  LOCATE 19,43:PRINT"MS-DOS"
  93. 900  LOCATE 19,5:INPUT "ENTER OPERATING SYSTEM (ie. MS-DOS)   ",OPER$
  94. 910  IF OPER$="" THEN OPER$="MS-DOS"
  95. 920  LOCATE 20,5:PRINT "                                          "
  96. 930  LOCATE 20,43:PRINT"DSDD"
  97. 940  LOCATE 20,5:INPUT "ENTER DISKETTE TYPE (ie. DSDD, SSSD)  ",DTYPE$
  98. 950  IF DTYPE$="" THEN DTYPE$="DSDD"
  99. 960  LOCATE 21,5:PRINT "                                           "
  100. 970  LOCATE 21,43:PRINT"9-SEC"
  101. 980  LOCATE 21,5:INPUT "ENTER NUMBER OF SECTORS (ie. 9-SEC)   ",STYPE$
  102. 990  IF STYPE$="" THEN STYPE$="9-SEC"
  103. 1000  LOCATE 22,5:PRINT "                                              "
  104. 1010  LOCATE 22,43:PRINT NDATE$
  105. 1020  LOCATE 22,5:INPUT "ENTER FORMAT DATE (8 CHAR - ANY FORM) ",FDATE$
  106. 1030  IF FDATE$="" THEN FDATE$=NDATE$ ELSE NDATE$=FDATE$
  107. 1040  LOCATE 23,5:PRINT "                                                "
  108. 1050  LOCATE 23,43:PRINT"IBM 360K "
  109. 1060  LOCATE 23,5:INPUT "ENTER DISKETTE MANUFACTURER           ",MTYPE$
  110. 1070  IF MTYPE$="" THEN MTYPE$="IBM 360K "
  111. 1080  LNE=2:COLOR 7,0:CLS
  112. 1090  LOCATE 1,2:PRINT "THE FOLLOWING PROGRAMS / FILES ARE ON THIS DISK:"
  113. 1100  GOSUB 1280 'COMPRESS NAMES
  114. 1110  FOR LOOP=0 TO COUNT%-1 STEP 4
  115. 1120  LNE=LNE+1:PST=2
  116. 1130  FOR LOOP1=LOOP TO LOOP+3
  117. 1140  IF DIRLST$(LOOP1)=FILLER$ THEN 1170
  118. 1150  LOCATE LNE,PST:PRINT LOOP1+1:LOCATE LNE,PST+3:PRINT"-"
  119. 1160  LOCATE LNE,PST+4:PRINT DIRLST$(LOOP1)
  120. 1170  PST=PST+19
  121. 1180  NEXT LOOP1
  122. 1190  NEXT LOOP
  123. 1200  COLOR 7,0
  124. 1210  LOCATE 20,1:PRINT "ENTER NUMBER OF FILE NAME TO BE PRINTED ON LABEL"
  125. 1220  LOCATE 21,1:PRINT "SELECTED ENTRIES WILL BE HIGHLIGHTED ON THE SCREEN"
  126. 1230  LOCATE 22,1:INPUT "ENTER A ZERO WHEN DONE / 99 TO SELECT ALL FILES";P
  127. 1240  LOCATE 22,50:PRINT "   "
  128. 1250  IF P=99 THEN 1270
  129. 1260  IF P>COUNT% THEN BEEP:GOTO 1230
  130. 1270  GOTO 1390
  131. 1280  REM COMPRESS PROGRAM NAME AND EXTENSION
  132. 1290  FOR X%=0 TO COUNT%-1
  133. 1300  DIRENT$=""
  134. 1310  FOR Y%=1 TO 12
  135. 1320  CH$=MID$(DIRLST$(X%),Y%,1)
  136. 1330  IF CH$=" " THEN 1350
  137. 1340  DIRENT$=DIRENT$+CH$
  138. 1350  NEXT Y%
  139. 1360  DIRLST$(X%)=DIRENT$
  140. 1370  NEXT X%
  141. 1380  RETURN
  142. 1390  IF P=0 THEN 1620
  143. 1400  IF P<>99 THEN 1450
  144. 1410  FOR N=0 TO COUNT%-1
  145. 1420  PROGSEL(N)=1
  146. 1430  NEXT N
  147. 1440  GOTO 1620
  148. 1450  IF P<1 OR P>64 THEN LOCATE 23,50:PRINT"NOT ACCEPTED":BEEP:GOTO 1230
  149. 1460  LOCATE 23,50:PRINT"            "
  150. 1470  N=N+1
  151. 1480  PROGSEL(P-1)=1
  152. 1490  IF N>55 THEN 1620
  153. 1500  LNE=INT((P/4)+0.99)+2
  154. 1510  LNX=LNE-2
  155. 1520  BYT=P-((LNX-1)*4)
  156. 1530  IF BYT=1 THEN BYT=2:GOTO 1570
  157. 1540  IF BYT=2 THEN BYT=21
  158. 1550  IF BYT=3 THEN BYT=40
  159. 1560  IF BYT=4 THEN BYT=59
  160. 1570  LOCATE LNE,BYT
  161. 1580  COLOR 0,7  '31,0
  162. 1590  PRINT P:LOCATE LNE,BYT+3:PRINT"-":LOCATE LNE,BYT+4:PRINT DIRLST$(P-1)
  163. 1600  COLOR 7,0
  164. 1610  GOTO 1200
  165. 1620  REM SET UP LABEL
  166. 1630  LOCATE 23,50:PRINT"WORKING     "
  167. 1640  COLOR 7,0:CLS
  168. 1650  COLOR 0,7:
  169. 1670  LOCATE 5,5:PRINT "YOU MAY ENTER THREE LINES OF COMMENTS - 70 CHAR. EACH"
  170. 1680  LOCATE 6,5:PRINT "LINE 3 MAY BE PRE-DEFINED. IF SO IT WILL BE BYPASSED."
  171. 1690  LOCATE 9,5:PRINT "[                                                                 ]"
  172. 1700  LOCATE 10,5:PRINT "[                                                                 ]"
  173. 1710  LOCATE 11,5:PRINT "[                                                                 ]"
  174. 1720  IF COMC$="" THEN 1730 ELSE LOCATE 11,6:PRINT COMC$
  175. 1730  LOCATE 9,6:INPUT "",COMA$
  176. 1740  LOCATE 10,6:INPUT "",COMB$
  177. 1750  IF COMC$="" THEN LOCATE 11,6:INPUT "",COMC$
  178. 1760  COLOR 7,0:LOCATE 14,20:INPUT "HOW MANY COPIES OF LABEL DO YOU WANT ";NC$:NC=VAL(NC$):IF NC<1 THEN 1760
  179. 1770  IF N>35 THEN JW= 11 ELSE JW= 7
  180. 1780  FOR LL= 1 TO NC
  181. 1785  GOSUB 2300
  182. 1790  LOCATE 10,20:PRINT "                                              "
  183. 1800  IF INKEY$=CHR$(27) THEN 2160
  184. 1810  LOCATE 10,20:PRINT "     PRINTING LABEL ";LL;" OF ";NC
  185. 1820  LPRINT TAB(1) TITLE$;
  186. 1830  LPRINT TAB(36) "#";DSER$
  187. 1840  LPRINT TAB(1) MTYPE$;
  188. 1850  LPRINT TAB(12) OPER$;"  ";DTYPE$;" ";STYPE$;"  ";FDATE$
  189. 1855  LPRINT CHR$(27);"A";CHR$(3);
  190. 1860  LPRINT "---------------------------------------"
  191. 1870  LPRINT CHR$(27);"F";         'SET EMPHASIZED OFF
  192. 1880  LPRINT CHR$(15);
  193. 1890  LPRINT CHR$(27);"A";CHR$(6);CHR$(27);"2";
  194. 1900  LPRINT CHR$(27);"S";CHR$(48);
  195. 1910  LNO=0:COL=0
  196. 1920  FOR X=0 TO 54
  197. 1930  IF PROGSEL(X)=0 THEN 2020
  198. 1940  COL=COL+1:IF X=0 THEN COL=1
  199. 1950  IF COL=1 THEN LPRINT TAB(3) DIRLST$(X);
  200. 1960  IF COL=2 THEN LPRINT TAB(16) DIRLST$(X);
  201. 1970  IF COL=3 THEN LPRINT TAB(29) DIRLST$(X);
  202. 1980  IF COL=4 THEN LPRINT TAB(42) DIRLST$(X);
  203. 1990  IF COL=5 THEN LPRINT TAB(55) DIRLST$(X):COL=0:LNO=LNO+1
  204. 2000  ' IF COL=6 THEN LPRINT TAB(68) DIRLST$(X):COL=0:LNO=LNO+1
  205. 2010  IF LNO=JW THEN 2030
  206. 2020  NEXT X
  207. 2030  IF COL>0 THEN LPRINT:LNO=LNO+1
  208. 2040  FOR X=1 TO (JW-LNO):LPRINT:NEXT X
  209. 2050  IF JW=11 THEN 2120 'SKIP DOTTED LINE AND COMMENTS IF MORE THAN 35 ENTRIES
  210. 2060  LPRINT "-------------------------------------------------------------------"
  211. 2080  LPRINT TAB(3) COMA$
  212. 2090  LPRINT TAB(3) COMB$
  213. 2100  LPRINT TAB(3) COMC$
  214. 2110  LPRINT
  215. 2120  LPRINT CHR$(27);"T";         'SET SUPERSCRIPT OFF
  216. 2130  LPRINT CHR$(27);"E";         'SET EMPHASIZED
  217. 2135  LPRINT CHR$(27);CHR$(18);    'SET 10 CHR PER INCH
  218. 2140  LPRINT CHR$(27);"A";CHR$(9);
  219. 2150  NEXT LL
  220. 2160  CLS:LOCATE 10,20:PRINT"REPRINT THIS LABEL? (`Y' TO REPRINT)"
  221. 2170  GOSUB 2210:IF KY$="Y" THEN 1760 ELSE LOCATE 10,20:PRINT "    WAIT.........RELOADING          ":GOTO 290
  222. 2180  CLS:GOSUB 2400
  223. 2190  SYSTEM
  224. 2200  END
  225. 2210  REM GET IN KEY AND OR
  226. 2220  KY$=INKEY$:IF KY$="" THEN 2220
  227. 2230  IF KY$=CHR$(27) THEN GOSUB 2400:END
  228. 2240  IF KY$<CHR$(97) OR KY$>CHR$(122) THEN 2260
  229. 2250  KY$=CHR$(ASC(KY$)-32)
  230. 2260  RETURN
  231. 2270  DIRECT=PEEK(SUBLC%+1)+PEEK(SUBLC%+2)*256
  232. 2280  RETURN
  233. 2300  LPRINT CHR$(24);
  234. 2305  LPRINT CHR$(27);CHR$(18);    'SET TEN CHAR PER INCH
  235. 2310  LPRINT CHR$(27);"G";         'SET DOUBLE STRIKE
  236. 2320  LPRINT CHR$(27);"A";CHR$(9); 'SET 8LPI
  237. 2330  LPRINT CHR$(27);"E";         'SET EMPHASIZED
  238. 2335  LPRINT CHR$(27);CHR$(18);    'SET TEN CHAR PER INCH
  239. 2340  LPRINT CHR$(27);"Q";CHR$(85); 'SET WIDTH
  240. 2350  RETURN
  241. 2400  COLOR 7,0
  242. 2410  LPRINT CHR$(24);
  243. 3220  RETURN
  244. 6000  N=COUNT%
  245. 6010  K=N:WHILE K>1:K=K/2
  246. 6020  FOR J=1 TO N-K:FOR I=J TO 1 STEP -K
  247. 6030  IF DIRLST$(I)>DIRLST$(I+K) THEN SWAP DIRLST$(I),DIRLST$(I+K):NEXT
  248. 6040  NEXT J:WEND:RETURN
  249.